(*
   Wimdows.mod - A user friendly Win32 API layer
	  Implementation module

   Copyright (c) 2007-2008, Wim Devesse
	 Last modified: 27/04/2008
*)

<* COMPILERHEAP="120000000" *>
<* +M2EXTENSIONS *>
<* +NOOPTIMIZE *>
<* +STORAGE *>
IMPLEMENTATION MODULE Wimdows;

(* --- IMPORT --- *)
FROM SYSTEM IMPORT ADR;
IMPORT Windows;

(* --- TYPE --- *)
(* Window properties -- *)
TYPE WinState = (STATE_DEAD, STATE_ACTIVE, STATE_ERROR); (* STATE_DEAD must be zero! *)
TYPE WinStruct = RECORD
      state: WinState;
      hwnd: Windows.HWND;
      class: Windows.PSTR;
			xlen, ylen: CARDINAL;
END;
(* Used for drawing -- *)
TYPE DrawType = (DR_LINE, DR_RECT, DR_ELLIPSE, DR_ARC, DR_PIE);
TYPE DrawStruct = RECORD
      object: DrawType;
			x0, y0, x1, y1: INTEGER;
			x2, y2, x3, y3: INTEGER;
			r: CARDINAL;
			a0, a1: REAL;
			color: Windows.COLORREF;
			fill: BOOLEAN;
END;
(* Bitmap properties -- *)
TYPE BitStruct = RECORD
      hbit: Windows.HGDIOBJ;
			hdc: Windows.HDC;
			width, height: CARDINAL;
END;
(* Font style & color -- *)
TYPE FontStruct = RECORD
      style: CARDINAL;
			color: Windows.COLORREF;
END;
(* Mouse state -- *)
TYPE MouseStruct = RECORD
      x, y: INTEGER;
			left, right: BOOLEAN;
			onLeftDown, onLeftUp, onRightDown, onRightUp, onDouble: BOOLEAN;
			LeftDownProc, LeftUpProc, RightDownProc, RightUpProc, DoubleProc: MouseProc;
END;
(* Queue element -- *)
TYPE QueueElmtPt = POINTER TO QueueElmt;
TYPE QueueElmt = RECORD
      key: CARDINAL;
			prev: QueueElmtPt;
END;
(* Key buffer (FIFO queue) -- *)
TYPE KeyBuffer = RECORD
      head, tail: QueueElmtPt;
END;

(* --- VAR --- *)
VAR window: WinStruct;
    hBitBuf: Windows.HBITMAP;
		hDCBuf: Windows.HDC;
		buffering: BOOLEAN;

		font: FontStruct;
		mouse: MouseStruct;
		key: ARRAY[0..255] OF BOOLEAN;
		keybuf: KeyBuffer;

		bit: POINTER TO ARRAY OF BitStruct;
		bitlen: CARDINAL;

		block: BOOLEAN;

(* --- Private procedures --- *)
PROCEDURE FreeWindow(); FORWARD;
PROCEDURE Init(): BOOLEAN; FORWARD;
PROCEDURE Paint(); FORWARD;
PROCEDURE AddKey( key: CARDINAL ); FORWARD;

(* -- Private general procedures -- *)
(* Returns the size of a number (+ 1 if it is negative) -- *)
PROCEDURE intlen( nr: INTEGER ): INTEGER;
VAR len, exp: INTEGER;
BEGIN
  len := 1;
	exp := nr;
	IF nr < 0 THEN
	  exp := -exp;
		len := 2;
	END;
	WHILE exp > 9 DO
	  exp := exp / 10;
		len := len + 1;
	END;

	RETURN len;
END intlen;

(* Converts a number to an array of CHAR -- *)
PROCEDURE Int2Char( VAR chp: ARRAY OF CHAR; nr: INTEGER );
VAR i, neg, len: INTEGER;
BEGIN
  neg := 0;
	len := intlen( nr );
  IF nr < 0 THEN
	  chp[0] := '-';
		nr := -nr;
		neg := 1;
	END;

	FOR i := len TO neg + 1 BY -1 DO
	  chp[i - 1] := CHR(nr MOD 10 + 48);
		nr := nr / 10;
	END;
	chp[len] := CHR(0);
END Int2Char;


(* -- Private window procedures -- *)
(* Win32 Callback procedure -- *)
PROCEDURE [Windows.CALLBACK] WindowProcedure( hwnd: Windows.HWND; msg: Windows.UINT; wParam: Windows.WPARAM; lParam: Windows.LPARAM ): Windows.LRESULT;
BEGIN
  CASE msg OF
	(* Repaint the window *)
	  Windows.WM_PAINT: Paint();

  (* Key pressed *)
	| Windows.WM_KEYDOWN: key[wParam MOD 256] := TRUE; AddKey( wParam MOD 256 );
	| Windows.WM_KEYUP: key[wParam MOD 256] := FALSE;

  (* Mouse moved *)
	| Windows.WM_MOUSEMOVE: WHILE block DO; END; mouse.x := Windows.LOWORD( lParam ); mouse.y := Windows.HIWORD( lParam );

  (* Left mouse click *)
	| Windows.WM_LBUTTONDOWN: mouse.left := TRUE;
														IF NOT mouse.right THEN Windows.SetCapture( hwnd ); END;
														IF mouse.onLeftDown THEN mouse.LeftDownProc( Windows.LOWORD( lParam ), Windows.HIWORD( lParam ) ); END;

	| Windows.WM_LBUTTONUP: mouse.left := FALSE;
	                        IF NOT mouse.right THEN Windows.ReleaseCapture(); END;
													IF mouse.onLeftUp THEN mouse.LeftUpProc( Windows.LOWORD( lParam ), Windows.HIWORD( lParam ) ); END;

  (* Right mouse click *)
	| Windows.WM_RBUTTONDOWN: mouse.right := TRUE;
	                          IF NOT mouse.left THEN Windows.SetCapture( hwnd ); END;
														IF mouse.onRightDown THEN mouse.RightDownProc( Windows.LOWORD( lParam ), Windows.HIWORD( lParam ) ); END;

	| Windows.WM_RBUTTONUP: mouse.right := FALSE;
	                        IF NOT mouse.left THEN Windows.ReleaseCapture(); END;
													IF mouse.onRightUp THEN mouse.RightUpProc( Windows.LOWORD( lParam ), Windows.HIWORD( lParam ) ); END;

  (* Double-click *)
	| Windows.WM_LBUTTONDBLCLK: IF mouse.onDouble THEN mouse.DoubleProc( Windows.LOWORD( lParam ), Windows.HIWORD( lParam ) ); END;

	| Windows.WM_CLOSE: Windows.DestroyWindow( hwnd );

	| Windows.WM_DESTROY: Windows.PostQuitMessage( 0 );

	ELSE RETURN Windows.DefWindowProc( hwnd, msg, wParam, lParam );
	END;
	RETURN 0;
END WindowProcedure;

(* Creates a new window and starts the message loop -- *)
PROCEDURE [Windows.CALLBACK] WinMain( lpParam: Windows.LPVOID ): Windows.DWORD;
VAR wc: Windows.WNDCLASSEX; msg: Windows.MSG; rc: Windows.RECT;
BEGIN
  (* Make a new window class *)
	wc.hInstance := Windows.GetModuleHandle( NIL );
	wc.lpszClassName := window.class;
	wc.lpfnWndProc := WindowProcedure;
	wc.style := Windows.CS_DBLCLKS;
	wc.cbSize := SIZE( Windows.WNDCLASSEX );
	wc.hIcon := Windows.LoadIcon( wc.hInstance, Windows.IDI_APPLICATION );
	wc.hIconSm := Windows.LoadIcon( wc.hInstance, Windows.IDI_APPLICATION );
	wc.hCursor := Windows.LoadCursor( NIL, Windows.IDC_ARROW );
	wc.lpszMenuName := NIL;
	wc.cbClsExtra := 0;
	wc.cbWndExtra := 0;
	wc.hbrBackground := Windows.GetSysColorBrush( Windows.COLOR_BACKGROUND );
	IF Windows.RegisterClassEx( wc ) = 0 THEN window.state := STATE_ERROR; RETURN 0; END;

  (* Calculate the size of the window *)
	rc.left := 0; rc.right := window.xlen; rc.top := 0; rc.bottom := window.ylen;
	Windows.AdjustWindowRect( rc, Windows.WS_CAPTION + Windows.WS_SYSMENU + Windows.WS_MINIMIZEBOX, FALSE );

  (* Create a window with this class *)
  window.hwnd := Windows.CreateWindow( window.class, window.class,                                       (* Class *)
	                                     Windows.WS_CAPTION + Windows.WS_SYSMENU + Windows.WS_MINIMIZEBOX, (* Style *)
																			 Windows.CW_USEDEFAULT, Windows.CW_USEDEFAULT,                     (* Position *)
	                                     rc.right - rc.left, rc.bottom - rc.top,                           (* Size *)
																			 Windows.HWND_DESKTOP, NIL, Windows.GetModuleHandle( NIL ), NIL ); (* Parent window *)

  (* Initialize this window *)
  IF (window.hwnd = NIL) OR (NOT Init()) THEN window.state := STATE_ERROR; RETURN 0; END;

  (* Show the new window *)
  Windows.ShowWindow( window.hwnd, Windows.SW_SHOWDEFAULT );
	Windows.UpdateWindow( window.hwnd );
	Windows.SetFocus( window.hwnd );

  (* Message loop *)
  window.state := STATE_ACTIVE;
  WHILE Windows.GetMessage( msg, NIL, 0, 0 ) DO
	  Windows.TranslateMessage( msg );
		Windows.DispatchMessage( msg );
	END;

  (* Window is closed *)
	FreeWindow();
	window.state := STATE_DEAD;

  RETURN msg.wParam;
END WinMain;

(* Frees the memory associated with the window -- *)
PROCEDURE FreeWindow();
VAR i: INTEGER;
BEGIN
  (* Unregister the window class so it can be reused *)
	Windows.UnregisterClass( window.class, Windows.GetModuleHandle( NIL ) );

	(* Clear all window variables *)
	DISPOSE( window.class );
	Windows.DeleteObject( hBitBuf );
	Windows.DeleteDC( hDCBuf );
	window.xlen := 0; window.ylen := 0;
	buffering := FALSE;

  (* Clear all mouse variables *)
  mouse.x := 0; mouse.y := 0;
	mouse.left := FALSE; mouse.right := FALSE;
	mouse.onLeftDown := FALSE; mouse.onLeftUp := FALSE;
	mouse.onRightDown := FALSE; mouse.onRightUp := FALSE; mouse.onDouble := FALSE;
	mouse.LeftDownProc := NIL; mouse.LeftUpProc := NIL;
	mouse.RightDownProc := NIL; mouse.RightUpProc := NIL; mouse.DoubleProc := NIL;

  (* Clear the keyboard buffers *)
	FOR i := 0 TO 255 DO key[i] := FALSE; END;
	FlushKeys;

  (* Clear all bitmaps *)
	IF bitlen > 0 THEN
	  FOR i := 0 TO INT(bitlen) - 1 DO
		  Windows.DeleteDC( bit^[i].hdc );
			Windows.DeleteObject( bit^[i].hbit );
		END;
		DISPOSE( bit );
		bitlen := 0;
	END;
END FreeWindow;

(* Sets screen size and creates the screen buffer -- *)
PROCEDURE Init(): BOOLEAN;
VAR rc: Windows.RECT; hdc: Windows.HDC;
BEGIN
  (* Set screen size *)
  IF NOT Windows.GetClientRect( window.hwnd, rc ) THEN RETURN FALSE; END;
	window.xlen := rc.right;
	window.ylen := rc.bottom;

  (* Create the buffer *)
  hdc := Windows.GetDC( window.hwnd );
	hBitBuf := Windows.CreateCompatibleBitmap( hdc, window.xlen, window.ylen );
	hDCBuf := Windows.CreateCompatibleDC( hdc );
	Windows.SelectObject( hDCBuf, hBitBuf );
	Windows.ReleaseDC( window.hwnd, hdc );

	RETURN TRUE;
END Init;

(* Adds an element to the key buffer -- *)
PROCEDURE AddKey( key: CARDINAL );
VAR elmt: QueueElmtPt;
BEGIN
  NEW( elmt );
	WHILE block DO; END;
	elmt^.key := key;
	elmt^.prev := NIL;
	IF keybuf.head # NIL THEN keybuf.head^.prev := elmt;
	ELSE keybuf.tail := elmt;
	END;
	keybuf.head := elmt;
END AddKey;

(* Removes an element from the key buffer -- *)
PROCEDURE DelKey;
VAR elmt: QueueElmtPt;
BEGIN
  IF keybuf.tail # NIL THEN
	  elmt := keybuf.tail;
		IF elmt^.prev # NIL THEN keybuf.tail := elmt^.prev;
		ELSE keybuf.tail := NIL; keybuf.head := NIL;
		END;
		DISPOSE( elmt );
	END;
END DelKey;


(* -- Private drawing procedures -- *)
(* Adds a bitmap to our dynamic array of bitmaps -- *)
PROCEDURE AddBitmap( addbit: Windows.HGDIOBJ; addhdc: Windows.HDC; width, height: INTEGER ): CARDINAL;
VAR i: INTEGER; tmp: POINTER TO ARRAY OF BitStruct; bitplace: CARDINAL; addspace: CARDINAL;
BEGIN
  bitplace := 0;
	addspace := 1;

  (* Make a backup of the bitmaps *)
	NEW( tmp, bitlen + 1 );
	FOR i := 0 TO INT(bitlen) - 1 DO
	  tmp^[i] := bit^[i];
		IF bit^[i].hbit = NIL THEN addspace := 0; END;
	END;
	tmp^[bitlen].hbit := NIL;
	IF bitlen > 0 THEN DISPOSE( bit ); END;
	NEW( bit, bitlen + addspace );
	(* Copy it back *)
	FOR i := 0 TO INT(bitlen) - 1 + INT(addspace) DO
	  (* Add the new bitmap if there is a free spot *)
		IF (tmp^[i].hbit = NIL) & (bitplace = 0) THEN
			bit^[i].hbit := addbit;
			bit^[i].width := width;
			bit^[i].height := height;
			bit^[i].hdc := addhdc;
			bitplace := i + 1;
		ELSE bit^[i] := tmp^[i];
		END;
	END;
	DISPOSE( tmp );
	bitlen := bitlen + addspace;

	RETURN ORD(bitplace);
END AddBitmap;

(* Removes a bitmap from our dynamic array of bitmaps -- *)
PROCEDURE DelBitmap( del: CARDINAL );
VAR i: INTEGER; tmp: POINTER TO ARRAY OF BitStruct;
BEGIN
  Windows.DeleteDC( bit^[del].hdc );
	Windows.DeleteObject( bit^[del].hbit );
	bit^[del].hbit := NIL;

	(* If it is the last bitmap of our array, we shrink the array *)
	IF (bitlen > 0) & (INT(del) = INT(bitlen) - 1) THEN
	  (* Calculate the new size of the array *)
		bitlen := bitlen - 1;
		i := INT(bitlen) - 1;
		WHILE (i >= 0) & (bit^[i].hbit = NIL) DO
		  bitlen := bitlen - 1;
			i := i - 1;
		END;
		(* Make a backup of the bitmaps *)
		IF bitlen > 0 THEN
		  NEW( tmp, bitlen );
			FOR i := 0 TO INT(bitlen) - 1 DO tmp^[i] := bit^[i]; END;
		END;
		DISPOSE( bit );
		(* Copy it back *)
		IF bitlen > 0 THEN
		  NEW( bit, bitlen );
			FOR i := 0 TO INT(bitlen) - 1 DO bit^[i] := tmp^[i]; END;
			DISPOSE( tmp );
		END;
	END;
END DelBitmap;

(* Converts RGB to COLORREF -- *)
PROCEDURE CreateColor( color: CARDINAL ): Windows.COLORREF;
BEGIN
  RETURN Windows.RGB( Windows.GetRValue( color ), Windows.GetBValue( color ), Windows.GetGValue( color ) );
END CreateColor;

(* Creates a font -- *)
PROCEDURE CreateFont( style: CARDINAL ): Windows.HGDIOBJ;
VAR fontnr: Windows.STOCK_ENUM;
BEGIN
  CASE style OF
	|	1: fontnr := Windows.SYSTEM_FONT;
	|	2: fontnr := Windows.SYSTEM_FIXED_FONT;
	| 3: fontnr := Windows.ANSI_VAR_FONT;
	| 4: fontnr := Windows.ANSI_FIXED_FONT;
	| 5: fontnr := Windows.OEM_FIXED_FONT;
	ELSE fontnr := Windows.DEFAULT_GUI_FONT;
	END;
	RETURN Windows.GetStockObject( fontnr );
END CreateFont;

(* Sets the members of the DrawStruct structure -- *)
PROCEDURE SetDraw( VAR draw: DrawStruct; x0, y0, x1, y1: INTEGER; color: CARDINAL; fill: BOOLEAN );
BEGIN
  IF x0 < x1 THEN draw.x0 := x0; draw.x1 := x1;
	ELSE draw.x0 := x1; draw.x1 := x0; END;
	IF y0 < y1 THEN draw.y0 := y0; draw.y1 := y1;
	ELSE draw.y0 := y1; draw.y1 := y0; END;
	draw.color := CreateColor( color );
	draw.fill := fill;
END SetDraw;

(* Draws something on the buffer -- *)
PROCEDURE DrawObject( VAR draw: DrawStruct );
VAR rc: Windows.RECT; pencolor: Windows.HPEN; rectcolor: Windows.HBRUSH;
BEGIN
  CASE draw.object OF
	| DR_LINE:
		pencolor := Windows.CreatePen( Windows.PS_SOLID, 0, draw.color );
		Windows.SelectObject( hDCBuf, pencolor );
		Windows.MoveToEx( hDCBuf, draw.x2, draw.y2, NIL );
		Windows.LineTo( hDCBuf, draw.x3, draw.y3 );
		Windows.SetPixel( hDCBuf, draw.x3, draw.y3, draw.color );
		Windows.DeleteObject( pencolor );
	| DR_RECT:
		Windows.SetRect( rc, draw.x0, draw.y0, draw.x1 + 1, draw.y1 + 1 );
		rectcolor := Windows.CreateSolidBrush( draw.color );
		IF draw.fill THEN Windows.FillRect( hDCBuf, rc, rectcolor );
		ELSE Windows.FrameRect( hDCBuf, rc, rectcolor ); END;
		Windows.DeleteObject( rectcolor );
	| DR_ELLIPSE:
	  pencolor := Windows.CreatePen( Windows.PS_SOLID, 0, draw.color );
		Windows.SelectObject( hDCBuf, pencolor );
		IF draw.fill THEN
		  rectcolor := Windows.CreateSolidBrush( draw.color );
			Windows.SelectObject( hDCBuf, rectcolor );
		ELSE Windows.SelectObject( hDCBuf, Windows.GetStockObject( Windows.NULL_BRUSH ) ); END;
		Windows.Ellipse( hDCBuf, draw.x0, draw.y0, draw.x1, draw.y1 );
		Windows.DeleteObject( pencolor );
		IF draw.fill THEN Windows.DeleteObject( rectcolor ); END;
	| DR_ARC:
	  pencolor := Windows.CreatePen( Windows.PS_SOLID, 0, draw.color );
		Windows.SelectObject( hDCBuf, pencolor );
		Windows.Arc( hDCBuf, draw.x0, draw.y0, draw.x1, draw.y1, draw.x2, draw.y2, draw.x3, draw.y3 );
		Windows.DeleteObject( pencolor );
	| DR_PIE:
	  pencolor := Windows.CreatePen( Windows.PS_SOLID, 0, draw.color );
		Windows.SelectObject( hDCBuf, pencolor );
		IF draw.fill THEN
		  rectcolor := Windows.CreateSolidBrush( draw.color );
			Windows.SelectObject( hDCBuf, rectcolor );
		ELSE Windows.SelectObject( hDCBuf, Windows.GetStockObject( Windows.NULL_BRUSH ) ); END;
		Windows.Pie( hDCBuf, draw.x0, draw.y0, draw.x1, draw.y1, draw.x2, draw.y2, draw.x3, draw.y3 );
		Windows.DeleteObject( pencolor );
		IF draw.fill THEN Windows.DeleteObject( rectcolor ); END;
	ELSE; END;
END DrawObject;

(* Draws something on the buffer and copies it to the screen -- *)
PROCEDURE UpdateDC( VAR draw: DrawStruct );
VAR hdc: Windows.HDC;
BEGIN
  IF window.state = STATE_ACTIVE THEN
	  (* Draw it on the buffer *)
		DrawObject( draw );

		(* If necessary, copy it to the screen *)
		IF NOT buffering THEN
		  hdc := Windows.GetDC( window.hwnd );
			Windows.BitBlt( hdc, draw.x0, draw.y0, draw.x1, draw.y1, hDCBuf, draw.x0, draw.y0, Windows.SRCCOPY );
			Windows.ReleaseDC( window.hwnd, hdc );
		END;
	END;
END UpdateDC;

(* Draws the buffer on the screen -- *)
PROCEDURE Paint();
VAR hdc: Windows.HDC; ps: Windows.PAINTSTRUCT;
BEGIN
  hdc := Windows.BeginPaint( window.hwnd, ps );
	Windows.BitBlt( hdc, 0, 0, window.xlen, window.ylen, hDCBuf, 0, 0, Windows.SRCCOPY );
	Windows.EndPaint( window.hwnd, ps );
END Paint;



(* --- Public procedures --- *)
(* -- Public window procedures -- *)
(* Creates a new window -- *)
PROCEDURE Window( title: ARRAY OF CHAR; x, y: CARDINAL );
VAR i: INTEGER; hthread: Windows.HANDLE; threadID, threadParam: Windows.DWORD; str: POINTER TO ARRAY OF CHAR;
BEGIN
  (* If there already is an active window, kill it *)
  IF window.state = STATE_ACTIVE THEN KillWindow; END;

  (* Save the window title and set the window size *)
  NEW( str, Windows.lstrlen( title ) + 1 );
	FOR i := 0 TO Windows.lstrlen( title ) DO str^[i] := title[i]; END;
  window.class := ADR( str^[0] );
	window.xlen := x;
	window.ylen := y;

  (* Create a new thread in which we will create the window *)
  hthread := Windows.CreateThread( NIL, 0, WinMain, ADR( threadParam ), Windows.CREATE_SET{VAL(Windows.CREATE_ENUM, 0)}, threadID );
  IF hthread = NIL THEN Windows.MessageBox( NIL, "Can't create window.", "Error", Windows.MB_OK + Windows.MB_ICONEXCLAMATION ); END;
  Windows.CloseHandle( hthread );

  (* Wait until the window is created *)
  WHILE window.state = STATE_DEAD DO; END;
	IF window.state = STATE_ERROR THEN window.state := STATE_DEAD; DISPOSE( window.class ); END;
END Window;

(* Kills the window -- *)
PROCEDURE KillWindow;
BEGIN
  IF window.state = STATE_ACTIVE THEN
	  Windows.SendMessage( window.hwnd, Windows.WM_CLOSE, 0, 0 );
		WHILE window.state # STATE_DEAD DO; END;
  ELSE window.state := STATE_DEAD; END;
END KillWindow;

(* Checks if the window is active -- *)
PROCEDURE WindowActive(): BOOLEAN;
BEGIN
  RETURN window.state = STATE_ACTIVE;
END WindowActive;

(* Sets the window title -- *)
PROCEDURE SetTitle( titel: ARRAY OF CHAR );
BEGIN
  IF window.state = STATE_ACTIVE THEN Windows.SetWindowText( window.hwnd, titel ); END;
END SetTitle;

(* Returns the window width -- *)
PROCEDURE GetWidth(): CARDINAL;
BEGIN
  RETURN window.xlen;
END GetWidth;

(* Returns the window height -- *)
PROCEDURE GetHeight(): CARDINAL;
BEGIN
  RETURN window.ylen;
END GetHeight;


(* -- Public keyboard and mouse procedures -- *)
(* Checks if a certain key is pressed -- *)
PROCEDURE KeyDown( k: CARDINAL ): BOOLEAN;
BEGIN
  IF k > 255 THEN RETURN FALSE; END;
  RETURN key[k];
END KeyDown;

(* Returns the last key that was pressed -- *)
PROCEDURE GetKey(): CARDINAL;
VAR key: CARDINAL;
BEGIN
  WHILE keybuf.tail = NIL DO; END;
	(* Make sure the other thread doesn't add another key while we're busy... *)
	block := TRUE;
  key := keybuf.tail^.key;
  DelKey;
	block := FALSE;
	RETURN key;
END GetKey;

(* Clears the key buffer -- *)
PROCEDURE FlushKeys;
BEGIN
  (* Make sure the other thread doesn't add another key while we're busy... *)
	block := TRUE;
	WHILE keybuf.tail # NIL DO DelKey; END;
	block := FALSE;
END FlushKeys;

(* Returns the position of the mouse cursor -- *)
PROCEDURE MousePos( VAR x, y: INTEGER );
BEGIN
  (* Make sure the other thread doesn't change the mouse position while we're busy... *)
  block := TRUE;
  x := mouse.x;
	y := mouse.y;
	block := FALSE;
END MousePos;

(* Checks if the right mouse button is pushed -- *)
PROCEDURE MouseLeft(): BOOLEAN;
BEGIN
  RETURN mouse.left;
END MouseLeft;

(* Checks if the right mouse button is pushed -- *)
PROCEDURE MouseRight(): BOOLEAN;
BEGIN
  RETURN mouse.right;
END MouseRight;

(* Executes the specified procedure when the user clicks the left mouse button or releases it -- *)
PROCEDURE OnMouseLeft( proc: MouseProc );
BEGIN
  IF proc # NIL THEN mouse.onLeftDown := TRUE;
	ELSE mouse.onLeftDown := FALSE; END;
	mouse.LeftDownProc := proc;
END OnMouseLeft;

PROCEDURE OnMouseLeftUp( proc: MouseProc );
BEGIN
  IF proc # NIL THEN mouse.onLeftUp := TRUE;
	ELSE mouse.onLeftUp := FALSE; END;
	mouse.LeftUpProc := proc;
END OnMouseLeftUp;

(* Executes the specified procedure when the user clicks the right mouse button or releases it -- *)
PROCEDURE OnMouseRight( proc: MouseProc );
BEGIN
  IF proc # NIL THEN mouse.onRightDown := TRUE;
	ELSE mouse.onRightDown := FALSE; END;
	mouse.RightDownProc := proc;
END OnMouseRight;

PROCEDURE OnMouseRightUp( proc: MouseProc );
BEGIN
  IF proc # NIL THEN mouse.onRightUp := TRUE;
	ELSE mouse.onRightUp := FALSE; END;
	mouse.RightUpProc := proc;
END OnMouseRightUp;

(* Executes the specified procedure when the user double-clicks -- *)
PROCEDURE OnMouseDouble( proc: MouseProc );
BEGIN
  IF proc # NIL THEN mouse.onDouble := TRUE;
	ELSE mouse.onDouble := FALSE; END;
	mouse.DoubleProc := proc;
END OnMouseDouble;

(* Stops executing the procedure when the user clicks -- *)
PROCEDURE StopOnMouseLeft;
BEGIN
  mouse.onLeftDown := FALSE;
	mouse.LeftDownProc := NIL;
END StopOnMouseLeft;

PROCEDURE StopOnMouseLeftUp;
BEGIN
  mouse.onLeftUp := FALSE;
	mouse.LeftUpProc := NIL;
END StopOnMouseLeftUp;

PROCEDURE StopOnMouseRight;
BEGIN
  mouse.onRightDown := FALSE;
	mouse.RightDownProc := NIL;
END StopOnMouseRight;

PROCEDURE StopOnMouseRightUp;
BEGIN
  mouse.onRightUp := FALSE;
	mouse.RightUpProc := NIL;
END StopOnMouseRightUp;

PROCEDURE StopOnMouseDouble;
BEGIN
  mouse.onDouble := FALSE;
	mouse.DoubleProc := NIL;
END StopOnMouseDouble;


(* -- Public drawing procedures -- *)
(* Sets buffering on or off -- *)
PROCEDURE SetBuffering( state: BOOLEAN );
BEGIN
  IF window.state = STATE_ACTIVE THEN
	  IF buffering & NOT state THEN UpdateWindow; END;
		buffering := state;
	END;
END SetBuffering;

(* Draws the buffer on the screen -- *)
PROCEDURE UpdateWindow;
VAR hdc: Windows.HDC;
BEGIN
  IF window.state = STATE_ACTIVE THEN
	  hdc := Windows.GetDC( window.hwnd );
		Windows.BitBlt( hdc, 0, 0, window.xlen, window.ylen, hDCBuf, 0, 0, Windows.SRCCOPY );
		Windows.ReleaseDC( window.hwnd, hdc );
	END;
END UpdateWindow;

(* Creates a color with red, green and blue components in the range 0 to 255 -- *)
PROCEDURE RgbColor( r, g, b: CARDINAL ): CARDINAL;
BEGIN
  IF r > 255 THEN r := 255; END;
	IF g > 255 THEN g := 255; END;
	IF b > 255 THEN b := 255; END;
  RETURN r + 100H * b + 10000H * g;
END RgbColor;

(* Clears the screen -- *)
PROCEDURE ClearScreen;
BEGIN
  (* Draw a big black rectangle *)
  Rectangle( 0, 0, window.xlen, window.ylen, 0, TRUE );
END ClearScreen;

(* Draws a pixel -- *)
PROCEDURE SetPixel( x, y: INTEGER; color: CARDINAL );
VAR rgbcolor: Windows.COLORREF; hdc: Windows.HDC;
BEGIN
  IF window.state = STATE_ACTIVE THEN
	  rgbcolor := CreateColor( color );
		Windows.SetPixel( hDCBuf, x, y, rgbcolor );
		IF NOT buffering THEN
		  hdc := Windows.GetDC( window.hwnd );
			Windows.SetPixel( hdc, x, y, rgbcolor );
			Windows.ReleaseDC( window.hwnd, hdc );
		END;
	END;
END SetPixel;

(* Returns the color of a pixel -- *)
PROCEDURE GetPixel( x, y: CARDINAL ): CARDINAL;
VAR rgbcolor: Windows.COLORREF;
BEGIN
  IF (window.state = STATE_ACTIVE) & (x < window.xlen) & (y < window.ylen) THEN
	  rgbcolor := Windows.GetPixel( hDCBuf, x, y );
		IF rgbcolor # Windows.CLR_INVALID THEN
		  RETURN Windows.GetRValue( rgbcolor ) + 100H * Windows.GetBValue( rgbcolor ) + 10000H * Windows.GetGValue( rgbcolor );
		END;
	END;
	RETURN 0;
END GetPixel;


(* Draws a line -- *)
PROCEDURE Line( x0, y0, x1, y1: INTEGER; color: CARDINAL );
VAR draw: DrawStruct;
BEGIN
  IF x0 < x1 THEN draw.x0 := x0; draw.x1 := x1;
	ELSE draw.x0 := x1; draw.x1 := x0; END;
	IF y0 < y1 THEN draw.y0 := y0; draw.y1 := y1;
	ELSE draw.y0 := y1; draw.y1 := y0; END;

	draw.x2 := x0; draw.y2 := y0; draw.x3 := x1; draw.y3 := y1;
	draw.color := CreateColor( color );
	draw.object := DR_LINE;
	UpdateDC( draw );
END Line;

(* Draws a rectangle -- *)
PROCEDURE Rectangle( x0, y0, x1, y1: INTEGER; color: CARDINAL; fill: BOOLEAN );
VAR draw: DrawStruct;
BEGIN
  SetDraw( draw, x0, y0, x1, y1, color, fill );
	draw.object := DR_RECT;
	UpdateDC( draw );
END Rectangle;

(* Draws a polygon with n points -- *)
PROCEDURE Polygon( n: CARDINAL; x, y: ARRAY OF CARDINAL; color: CARDINAL; fill: BOOLEAN );
VAR i: CARDINAL; hdc: Windows.HDC; pencolor: Windows.HPEN; rectcolor: Windows.HBRUSH; xmin, xmax, ymin, ymax: CARDINAL; point: POINTER TO ARRAY OF Windows.POINT;
BEGIN
  IF (window.state = STATE_ACTIVE) & (n # 0) THEN
	  NEW( point, n );
		(* Retrieve the bounding rectangle (drawing area) and fill the points array *)
		xmin := x[0]; xmax := x[0]; ymin := y[0]; ymax := y[0];
		point^[0].x := x[0]; point^[0].y := y[0];
		FOR i := 1 TO n - 1 DO
		  IF x[i] < xmin THEN xmin := x[i]; END;
			IF x[i] > xmax THEN xmax := x[i]; END;
			IF y[i] < ymin THEN ymin := y[i]; END;
			IF y[i] > ymax THEN ymax := y[i]; END;
			point^[i].x := x[i]; point^[i].y := y[i];
		END;

		pencolor := Windows.CreatePen( Windows.PS_SOLID, 0, color );
		Windows.SelectObject( hDCBuf, pencolor );
		IF fill THEN
		  rectcolor := Windows.CreateSolidBrush( color );
			Windows.SelectObject( hDCBuf, rectcolor );
		ELSE Windows.SelectObject( hDCBuf, Windows.GetStockObject( Windows.NULL_BRUSH ) ); END;
		Windows.SetPolyFillMode( hDCBuf, Windows.WINDING );
		Windows.Polygon( hDCBuf, point^, n );
		Windows.DeleteObject( pencolor );
		IF fill THEN Windows.DeleteObject( rectcolor ); END;

		IF NOT buffering THEN
		  hdc := Windows.GetDC( window.hwnd );
			Windows.BitBlt( hdc, xmin, ymin, xmax, ymax, hDCBuf, xmin, ymin, Windows.SRCCOPY );
			Windows.ReleaseDC( window.hwnd, hdc );
		END;

		DISPOSE( point );
	END;
END Polygon;

(* Draws an ellipse -- *)
PROCEDURE Ellipse( x0, y0, x1, y1: INTEGER; color: CARDINAL; fill: BOOLEAN );
VAR draw: DrawStruct;
BEGIN
  SetDraw( draw, x0, y0, x1, y1, color, fill );
	draw.object := DR_ELLIPSE;
	UpdateDC( draw );
END Ellipse;

(* Draws an arc -- *)
PROCEDURE Arc( x0, y0, x1, y1, x2, y2, x3, y3: INTEGER; color: CARDINAL );
VAR draw: DrawStruct;
BEGIN
  SetDraw( draw, x0, y0, x1, y1, color, FALSE );
	draw.x2 := x2; draw.y2 := y2; draw.x3 := x3; draw.y3 := y3;
	draw.object := DR_ARC;
	UpdateDC( draw );
END Arc;

(* Draws a pie -- *)
PROCEDURE Pie( x0, y0, x1, y1, x2, y2, x3, y3: INTEGER; color: CARDINAL; fill: BOOLEAN );
VAR draw: DrawStruct;
BEGIN
  SetDraw( draw, x0, y0, x1, y1, color, fill );
	draw.x2 := x2; draw.y2 := y2; draw.x3 := x3; draw.y3 := y3;
	draw.object := DR_PIE;
	UpdateDC( draw );
END Pie;

(* Draws a circle -- *)
PROCEDURE Circle( x0, y0: INTEGER; radius: CARDINAL; color: CARDINAL );
BEGIN
  Ellipse( x0 - INT(radius), y0 - INT(radius), x0 + INT(radius), y0 + INT(radius), color, FALSE );
END Circle;

(* Draws a filled circle -- *)
PROCEDURE Disc( x0, y0: INTEGER; radius: CARDINAL; color: CARDINAL );
BEGIN
  Ellipse( x0 - INT(radius), y0 - INT(radius), x0 + INT(radius), y0 + INT(radius), color, TRUE );
END Disc;


(* Sets the font -- *)
PROCEDURE SetFont( style: CARDINAL; color: CARDINAL );
BEGIN
  font.style := style;
	font.color := CreateColor( color );
END SetFont;

(* Draws text -- *)
PROCEDURE Text( text: ARRAY OF CHAR; x, y: INTEGER );
VAR hdc: Windows.HDC; width, height: CARDINAL;
BEGIN
  IF window.state = STATE_ACTIVE THEN
	  Windows.SelectObject( hDCBuf, CreateFont( font.style ) );
		Windows.SetTextColor( hDCBuf, font.color );
		Windows.SetBkMode( hDCBuf, Windows.TRANSPARENT );
		Windows.TextOut( hDCBuf, x, y, text, Windows.lstrlen( text ) );
		Windows.SetBkMode( hDCBuf, Windows.OPAQUE );

		IF NOT buffering THEN
		  GetTextSize( text, font.style, width, height );
			hdc := Windows.GetDC( window.hwnd );
			Windows.BitBlt( hdc, x, y, x + INT(width), y + INT(height), hDCBuf, x, y, Windows.SRCCOPY );
			Windows.ReleaseDC( window.hwnd, hdc );
		END;
	END;
END Text;

(* Draws a CARDINAL number -- *)
PROCEDURE TextCard( number: CARDINAL; x, y: INTEGER );
BEGIN
  TextInt( INT(number), x, y );
END TextCard;

(* Draws an INTEGER number -- *)
PROCEDURE TextInt( number: INTEGER; x, y: INTEGER );
VAR text: POINTER TO ARRAY OF CHAR;
BEGIN
  NEW( text, intlen( number ) + 1 );
	Int2Char( text^, number );
	Text( text^, x, y );
	DISPOSE( text );
END TextInt;

(* Gets the text width and height in the specified font style -- *)
PROCEDURE GetTextSize( text: ARRAY OF CHAR; style: CARDINAL; VAR width, height: CARDINAL );
VAR size: Windows.SIZEL; hdc: Windows.HDC;
BEGIN
	size.cx := 0; size.cy := 0;

	IF window.state = STATE_ACTIVE THEN
	  hdc := Windows.GetDC( window.hwnd );
		Windows.SelectObject( hdc, CreateFont( style ) );
		Windows.GetTextExtentPoint32( hdc, text, Windows.lstrlen( text ), size );
		Windows.ReleaseDC( window.hwnd, hdc );
	END;

	width := size.cx;
	height := size.cy;
END GetTextSize;


(* -- Public bitmap procedures -- *)
(* Loads 'file' as a bitmap with specified width and height -- *)
PROCEDURE LoadBitmap( file: ARRAY OF CHAR; width, height: CARDINAL ): CARDINAL;
VAR hbitmap: Windows.HANDLE; hdc: Windows.HDC; tmp: POINTER TO Windows.HGDIOBJ;
BEGIN
  hbitmap := Windows.LoadImage( NIL, file, Windows.IMAGE_BITMAP, width, height, Windows.LR_LOADFROMFILE );
	hdc := Windows.CreateCompatibleDC( hDCBuf );
	tmp := ADR( hbitmap );
	Windows.SelectObject( hdc, tmp^ );

	IF hbitmap # NIL THEN RETURN AddBitmap( tmp^, hdc, width, height );
	ELSE RETURN 0; END;
END LoadBitmap;

(* Destroys a bitmap by erasing it from memory -- *)
PROCEDURE DestroyBitmap( bitmap: CARDINAL );
BEGIN
  IF (bitmap <= bitlen) & (bitmap # 0) & (bit^[bitmap - 1].hbit # NIL) THEN
	  DelBitmap( bitmap - 1 );
	END;
END DestroyBitmap;

(* Draws the bitmap at the specified position -- *)
PROCEDURE DrawBitmap( bitmap: CARDINAL; x, y: INTEGER );
VAR hdc: Windows.HDC;
BEGIN
  IF (window.state = STATE_ACTIVE) & (bitmap <= bitlen) & (bitmap # 0) & (bit^[bitmap - 1].hbit # NIL) THEN
	  bitmap := bitmap - 1;
		Windows.BitBlt( hDCBuf, x, y, bit^[bitmap].width, bit^[bitmap].height, bit^[bitmap].hdc, 0, 0, Windows.SRCCOPY );
		IF NOT buffering THEN
		  hdc := Windows.GetDC( window.hwnd );
			Windows.BitBlt( hdc, x, y, bit^[bitmap].width, bit^[bitmap].height, bit^[bitmap].hdc, 0, 0, Windows.SRCCOPY );
			Windows.ReleaseDC( window.hwnd, hdc );
		END;
	END;
END DrawBitmap;

(* Draws a bitmap using a mask -- *)
PROCEDURE DrawMaskBitmap( bitmap, maskbitmap: CARDINAL; x, y: INTEGER );
VAR hdc: Windows.HDC;
BEGIN
  IF (window.state = STATE_ACTIVE) & (bitmap <= bitlen) & (maskbitmap <= bitlen) & (bitmap # 0) & (maskbitmap # 0) & (bit^[bitmap - 1].hbit # NIL) & (bit^[maskbitmap - 1].hbit # NIL) THEN
	  bitmap := bitmap - 1;
		Windows.MaskBlt( hDCBuf, x, y, bit^[bitmap].width, bit^[bitmap].height, bit^[bitmap].hdc, 0, 0, bit^[maskbitmap - 1].hbit, 0, 0, 0AACC0020H );
		IF NOT buffering THEN
		  hdc := Windows.GetDC( window.hwnd );
			Windows.MaskBlt( hdc, x, y, bit^[bitmap].width, bit^[bitmap].height, bit^[bitmap].hdc, 0, 0, bit^[maskbitmap - 1].hbit, 0, 0, 0AACC0020H );
			Windows.ReleaseDC( window.hwnd, hdc );
		END;
	END;
END DrawMaskBitmap;

(* Creates an empty bitmap -- *)
PROCEDURE CreateBitmap( width, height: CARDINAL ): CARDINAL;
VAR hbitmap: Windows.HBITMAP; hdc: Windows.HDC; tmp: POINTER TO Windows.HGDIOBJ;
BEGIN
  IF (width > 0) & (height > 0) THEN
	  hbitmap := Windows.CreateCompatibleBitmap( hDCBuf, width, height );
		hdc := Windows.CreateCompatibleDC( hDCBuf );
		tmp := ADR( hbitmap );
		Windows.SelectObject( hdc, tmp^ );

		IF hbitmap # NIL THEN RETURN AddBitmap( tmp^, hdc, width, height ); END;
	END;
	RETURN 0;
END CreateBitmap;

(* Creates an empty mask bitmap -- *)
PROCEDURE CreateMaskBitmap( width, height: CARDINAL ): CARDINAL;
VAR hbitmap: Windows.HBITMAP; hdc: Windows.HDC; tmp: POINTER TO Windows.HGDIOBJ;
BEGIN
  IF (width > 0) & (height > 0) THEN
	  hdc := Windows.CreateCompatibleDC( NIL );
	  hbitmap := Windows.CreateCompatibleBitmap( hdc, width, height );
		Windows.DeleteDC( hdc );
		hdc := Windows.CreateCompatibleDC( hDCBuf );
		tmp := ADR( hbitmap );
		Windows.SelectObject( hdc, tmp^ );

		IF hbitmap # NIL THEN RETURN AddBitmap( tmp^, hdc, width, height ); END;
	END;
	RETURN 0;
END CreateMaskBitmap;

(* Converts an array of colors to a bitmap -- *)
PROCEDURE ArrayToBitmap( VAR colors: ARRAY OF ARRAY OF CARDINAL; width, height: CARDINAL ): CARDINAL;
VAR x, y: CARDINAL; hbitmap: Windows.HBITMAP; hdc: Windows.HDC; tmp: POINTER TO Windows.HGDIOBJ;
BEGIN
  IF (HIGH( colors ) > 0) & (HIGH( colors[0] ) > 0) & (width <= HIGH( colors ) + 1) AND (height <= HIGH( colors[0] ) + 1) THEN
	  hbitmap := Windows.CreateCompatibleBitmap( hDCBuf, width, height );
		hdc := Windows.CreateCompatibleDC( hDCBuf );
		Windows.SelectObject( hdc, hbitmap );

		FOR x := 0 TO width - 1 DO
		  FOR y := 0 TO height - 1 DO
			  Windows.SetPixel( hdc, x, y, CreateColor( colors[x][y] ) );
			END;
		END;
		tmp := ADR( hbitmap );
		RETURN AddBitmap( tmp^, hdc, width, height );
	ELSE RETURN 0;
	END;
END ArrayToBitmap;

(* Converts an array of BOOLEAN to a monochrome bitmap -- *)
PROCEDURE ArrayToMaskBitmap( VAR colors: ARRAY OF ARRAY OF BOOLEAN; width, height: CARDINAL ): CARDINAL;
VAR x, y: CARDINAL; hbitmap: Windows.HBITMAP; hdc: Windows.HDC; tmp: POINTER TO Windows.HGDIOBJ;
BEGIN
  IF (HIGH( colors ) > 0) & (HIGH( colors[0] ) > 0) & (width <= HIGH( colors ) + 1) & (height <= HIGH( colors[0] ) + 1) THEN
	  hdc := Windows.CreateCompatibleDC( NIL );
		hbitmap := Windows.CreateCompatibleBitmap( hdc, width, height );
		Windows.DeleteDC( hdc );
		hdc := Windows.CreateCompatibleDC( hDCBuf );
		Windows.SelectObject( hdc, hbitmap );

		FOR x := 0 TO width - 1 DO
		  FOR y := 0 TO height - 1 DO
			  IF colors[x][y] THEN Windows.SetPixel( hdc, x, y, CreateColor( _clrBRIGHTWHITE ) );
				ELSE Windows.SetPixel( hdc, x, y, CreateColor( _clrBLACK ) );
				END;
			END;
		END;
		tmp := ADR( hbitmap );
		RETURN AddBitmap( tmp^, hdc, width, height );
	ELSE RETURN 0;
	END;
END ArrayToMaskBitmap;

(* Converts a bitmap to an array of colors -- *)
PROCEDURE BitmapToArray( bitmap: CARDINAL; VAR colors: ARRAY OF ARRAY OF CARDINAL; width, height: CARDINAL );
VAR x, y: CARDINAL; rgbcolor: Windows.COLORREF;
BEGIN
  IF (bitmap <= bitlen) & (bitmap # 0) & (bit^[bitmap - 1].hbit # NIL) &
	   (HIGH( colors ) > 0) & (HIGH( colors[0] ) > 0) & (width <= HIGH( colors ) + 1) & (height <= HIGH( colors[0] ) + 1) THEN
		FOR x := 0 TO width - 1 DO
		  FOR y := 0 TO height - 1 DO
			  rgbcolor := Windows.GetPixel( bit^[bitmap - 1].hdc, x, y );
				colors[x][y] := Windows.GetRValue( rgbcolor ) + 100H * Windows.GetBValue( rgbcolor ) + 10000H * Windows.GetGValue( rgbcolor );
			END;
		END;
	END;
END BitmapToArray;

(* Converts a bitmap to an array of BOOLEAN -- *)
PROCEDURE BitmapToMaskArray( bitmap: CARDINAL; VAR colors: ARRAY OF ARRAY OF BOOLEAN; width, height: CARDINAL );
VAR x, y: CARDINAL; rgbcolor: Windows.COLORREF;
BEGIN
  IF (bitmap <= bitlen) & (bitmap # 0) & (bit^[bitmap - 1].hbit # NIL) &
	   (HIGH( colors ) > 0) & (HIGH( colors[0] ) > 0) & (width <= HIGH( colors ) + 1) & (height <= HIGH( colors[0] ) + 1) THEN
		FOR x := 0 TO width - 1 DO
		  FOR y := 0 TO height - 1 DO
			  rgbcolor := Windows.GetPixel( bit^[bitmap - 1].hdc, x, y );
				colors[x][y] := (Windows.GetRValue( rgbcolor ) + 100H * Windows.GetBValue( rgbcolor ) + 10000H * Windows.GetGValue( rgbcolor )) # 0;
			END;
		END;
	END;
END BitmapToMaskArray;

(* Copies a part of the source bitmap to the destination bitmap -- *)
PROCEDURE CopyBitmap( srcbitmap, destbitmap: CARDINAL; xsrc, ysrc, xdest, ydest: INTEGER; width, height: CARDINAL );
BEGIN
  IF (srcbitmap <= bitlen) & (destbitmap <= bitlen) & (srcbitmap # 0) & (destbitmap # 0) & (bit^[srcbitmap - 1].hbit # NIL) & (bit^[destbitmap - 1].hbit # NIL) THEN
		Windows.BitBlt( bit^[destbitmap - 1].hdc, xdest, ydest, width, height, bit^[srcbitmap - 1].hdc, xsrc, ysrc, Windows.SRCCOPY );
	END;
END CopyBitmap;

(* Copies a part of the source bitmap to the destination bitmap using a mask -- *)
PROCEDURE CopyMaskBitmap( srcbitmap, destbitmap, maskbitmap: CARDINAL; xsrc, ysrc, xdest, ydest: INTEGER; width, height: CARDINAL );
BEGIN
  IF (srcbitmap <= bitlen) & (destbitmap <= bitlen) & (maskbitmap <= bitlen) & (srcbitmap # 0) & (destbitmap # 0) & (maskbitmap # 0) & (bit^[srcbitmap - 1].hbit # NIL) & (bit^[destbitmap - 1].hbit # NIL) & (bit^[maskbitmap - 1].hbit # NIL) THEN
		Windows.MaskBlt( bit^[destbitmap - 1].hdc, xdest, ydest, width, height, bit^[srcbitmap - 1].hdc, xsrc, ysrc, bit^[maskbitmap - 1].hbit, 0, 0, 0AACC0020H );
	END;
END CopyMaskBitmap;

(* Copies a part of the screen buffer to the bitmap -- *)
PROCEDURE CopyScreen( bitmap: CARDINAL; xsrc, ysrc, xdest, ydest: INTEGER; width, height: CARDINAL );
BEGIN
  IF (window.state = STATE_ACTIVE) & (bitmap <= bitlen) & (bitmap # 0) & (bit^[bitmap - 1].hbit # NIL) THEN
	  Windows.BitBlt( bit^[bitmap - 1].hdc, xdest, ydest, width, height, hDCBuf, xsrc, ysrc, Windows.SRCCOPY );
	END;
END CopyScreen;

(* Inverts the colors of the bitmap -- *)
PROCEDURE InvertBitmap( bitmap: CARDINAL );
BEGIN
  IF (bitmap <= bitlen) & (bitmap # 0) & (bit^[bitmap - 1].hbit # NIL) THEN
	  InvertBitmapPart( bitmap, 0, 0, bit^[bitmap - 1].width, bit^[bitmap - 1].height );
	END;
END InvertBitmap;

(* Inverts the colors of a part of the bitmap -- *)
PROCEDURE InvertBitmapPart( bitmap: CARDINAL; x, y: INTEGER; width, height: CARDINAL );
VAR rc: Windows.RECT;
BEGIN
  IF (bitmap <= bitlen) & (bitmap # 0) & (bit^[bitmap - 1].hbit # NIL) THEN
	  rc.left := x; rc.top := y;
		rc.right := x + INT(width); rc.bottom := y + INT(height);
		Windows.InvertRect( bit^[bitmap - 1].hdc, rc );
	END;
END InvertBitmapPart;

END Wimdows.
